perm filename MUS5.F4[STR,LCS] blob
sn#339445 filedate 1978-03-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C****** MUSIC-5 -- WILL READ STANFORD-IRCAM FORMAT *******
C00025 00003 CGEN1 FUNCTION GENERATOR 1
C00039 ENDMK
C⊗;
C****** MUSIC-5 -- WILL READ STANFORD-IRCAM FORMAT *******
C******* LOAD MUS5.F4,MUS5TR,MUS5IO.FAI,PLAY5.FAI ******
CPASS3 PASS 3 MAIN PROGRAM
C *** MUSIC V ***
C DATA SPECIFICATION
INTEGER PEAK
DIMENSION T(50),TI(50),ITI(50)
COMMON I(15000),P(100)/PARM/IP(20)/FINOUT/PEAK,NRSOR
CC******* DATA IIIRD/Z5EECE66D/
DATA IIIRD/976545367/,SBFILN/"556563514300/
C SET I ARRAY =0 (7/10/69)
CC DATA I/15000*0/,I(4)/12800.0/
C************** DEFAULT SAMPLING RATE = 12800
DATA I/15000*0/
C INIALIZATION OF PIECE
C ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
I(7)=IIIRD
IP9=IP(9)
C IFIRST IS INIT. FLAG IN MUS5 TRANSLATOR
CALL ERRSET(0)
C****MUS5TR****************************************
CC******* NREAD = 3
CC******* NWRITE = 2
CM21 NREAD=21
C PDP DSK1=DEV.21
CM NWRITE=1
C PDP DSK=DEV.1
CM REWIND NREAD
CM REWIND NWRITE
CM1919 TYPE 10001
CM ACCEPT 10002,FLNM,IDSK
C TYPE 'PASS2' OR FILENAME + ANY POS.NUMB. TO WRITE SMPLS ON DSK.
CM IF(FLNM.EQ.' '.OR.FLNM.EQ.'PASS2')FLNM='FOR21'
CM IF(FLNM.NE.'PLAY')GO TO 1920
CM CALL PLAY
CM GO TO 1919
CM1920 IF(FLNM)GO TO 1921
C TYPE NON-LETTER TO GET TO TRANS.
CM NREAD=0
CM GO TO 204
CM1921 CALL IFILE(21,FLNM)
CM10003 IDSK=-1
CM10001 FORMAT(' TYPE INST. FILE NAME '$)
CM10002 FORMAT(A5,I)
C**** ABOVE FOR PDP IO ********
IFIRST=-1
C****MUS5TR****************************************
CX I(4)=IP(3) I(4)=12800 IN DATA STATEMENT
I(2)=IP(4)
10004 SCLFT=IP(12)
PEAK=0
NRSOR=0
IDSK=0
MS1=IP(7)
MS3=MS1+(IP(8)*IP(9))-1
MS2=IP(8)
C*** INITS THE SMPL RATE. DON'T DO IT EVERY TIME. I(4)=IP(3)
MOUT=IP(10)
C INITIALIZATION OF SECTION
5 T(1)=0.0
DO 220N1=MS1,MS3,MS2
220 I(N1)=-1
DO 221N1=1,IP9
221 TI(N1)=1000000.
C MAIN CARD READING LOOP
C****MUS5TR****************************************
204 CALL DATA (IFIRST)
IF(IFIRST.GT.0)GO TO 10004
C****MUS5TR****************************************
CM IF(NREAD)GO TO 21 !******** FOR TRANSLATOR
C IF EOF FOUND GO BACK AND READ ANOTHER FILE. INSTS CAN BE IN
C A SEPARATE FILE. (ALSO GENS)
IF(P(2)-T(1))200,200,244
200 IOP=P(1)
IF(IOP)201,201,202
201 CALLERROR(1)
GO TO 204
202 IF(IP(1)-IOP)201,203,203
203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP
11 IVAR=P(3)
IVARE=IVAR+I(1)-4
DO 297 N1=IVAR,IVARE
IVARP=N1-IVAR+4
297 I(N1)=P(IVARP)
GO TO 204
3 IGEN=P(3)
GO TO (281,282,283,284,285),IGEN
281 CALLGEN1
GO TO 204
282 CALLGEN2
GO TO 204
283 CALLGEN3
GO TO 204
284 CALLGEN4
GO TO 204
285 CALLGEN5
GO TO 204
4 IVAR=P(3)
IVARE=IVAR+I(1)-4
DO 296N1=IVAR,IVARE
IVARP=N1-IVAR+4
296 I(N1+100)=P(IVARP)*SCLFT
GO TO 204
C****MUS5TR****************************************
6 CALL FROUT3(IDSK)
C****MUS5TR****************************************
GO TO 204
CM GO TO 1919
CC STOP
C ENTER NOTE TO BE PLAYED
1 DO 230N1=MS1,MS3,MS2
IF(I(N1)+1)230,231,230
230 CONTINUE
CALLERROR(2)
GO TO 204
231 M1=N1
M2=N1+I(1)-1
M3=M2+1
M4=N1+IP(8)-1
DO 232N1=M1,M2
M5=N1-M1+1
232 I(N1)=P(M5)*SCLFT
I(M1 )=P(3)
DO 233N1=M3,M4
233 I(N1)=0
DO 235N1=1,IP9
IF(TI(N1)-1000000.)235,234,235
234 TI(N1)=P(2)+P(4)
ITI(N1)=M1
GO TO 204
235 CONTINUE
CALLERROR(3)
GO TO 204
C DEFINE INSTRUMENT
2 M1=I(2)
M2=IP(5)+IFIX(P(3))
I(M2)=M1
C****MUS5TR****************************************
218 CALL DATA (IFIRST)
C****MUS5TR****************************************
IF(I(1)-2)210,210,211
210 I(M1)=0
I(2)=M1+1
GO TO 204
211 I(M1)=P(3)
M3=I(1)
I(M1+1)=M1+M3-1
M1=M1+2
DO 217N1=4,M3
M5=P(N1)
IF(M5)212,213,213
212 IF(M5+100)300,301,301
300 I(M1)=-IP(2)+(M5+101)*IP(6)
GO TO 216
301 I(M1)=-IP(13)+(M5+1)*IP(14)
GO TO 216
213 IF(M5- 100 )214,214,215
214 I(M1)=M5
GO TO 216
215 I(M1)=M5+262144
216 M1=M1+1
217 CONTINUE
GO TO 218
C PLAY TO ACTION TIME
244 T(2)=P(2)
250 TMIN=1000000.
IREST=1
DO 241N1=1,IP9
IF(TMIN-TI(N1))241,241,240
240 TMIN=TI(N1)
MNOTE=N1
241 CONTINUE
IF(1000000.-TMIN)251,251,243
243 IF(TMIN-T(2))245,245,246
245 T(3)=TMIN
GO TO 260
246 T(3)=T(2)
GO TO 260
247 IF(T(1)-T(2))249,200,200
249 TI(MNOTE)=1000000.
M2=ITI(MNOTE)
I(M2)=-1
GO TO 250
C SETUP REST
251 T(3)=T(2)
IREST=2
C PLAY
260 IF(I(4).EQ.0)PAUSE' *** NO SAMPLING RATE?? ***'
ISAM=(T(3)-T(1))*FLOAT(I(4))+.5
T(1)=T(3)
IF(ISAM)247,247,266
266 IF(ISAM-IP(14))262,262,263
262 I(5)=ISAM
ISAM=0
GO TO 264
263 I(5)=IP(14)
ISAM=ISAM-IP(14)
264 IF(I(8))290,290,291
290 M3=MOUT+I(5)-1
MSAMP=I(5)
GO TO 292
291 M3=MOUT+(2*I(5))-1
MSAMP=2*I(5)
292 DO 267N1=MOUT,M3
267 I(N1)=0
GO TO (268,265),IREST
268 DO 270NS1=MS1,MS3,MS2
IF(I(NS1)+1)271,270,271
C GO THROUGH UNIT GENERATORS IN INSTRUMENT
271 I(3)=NS1
IGEN=IP(5)+I(NS1)
IGEN=I(IGEN)
272 I(6)=IGEN
CC***** IF(I(IGEN)-101)293,294,294
CC***** 293 CALLSAMGEN(I)
C**** ABOVE FOR MACHINE LANG. UNIT GENERATORS *******
CC***** GO TO 295
294 CALLFORSAM
295 IGEN=I(IGEN+1)
IF(I(IGEN))270,270,272
270 CONTINUE
265 CALL SAMOUT(IDSK ,MSAMP)
IF(ISAM)247,247,266
END
CFORS3 FORTRAN UNIT GENERATOR ROUTINE
C *** MUSIC V ***
SUBROUTINE FORSAM
DIMENSION I(15000),P(100),IP(20),L(8),M(8)
COMMON I,P/PARM/IP
EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5))>(M6,M
1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(
2L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(RN1,IRN1),(RN3,IRN3),(RN,I
3RN)
CC***** DATA IMULT/Z5EECE66D/
DATA IIIRD/976545367/
SFI=1./FLOAT(IP(12))
SFF=1./FLOAT(IP(15))
SFID=FLOAT(IP(12))
SFXX=FLOAT(IP(12))/FLOAT(IP(15))
XNFUN=IP(6)-1
C COMMON INITIALIZATION OF GENERATORS
N1=I(6)+2
N2=I(N1-1)-1
DO 204J1=N1,N2
J2=J1-N1+1
IF(I(J1))200,201,201
200 L(J2)=-I(J1)
M(J2)=1
GO TO 204
201 M(J2)=0
IF(I(J1)-262144)202,202,203
C***** WHAT DOES THE BIG NUMBER DO?????
202 L(J2)=I(J1)+I(3)-1
GO TO 204
203 L(J2)=I(J1)-262144
204 CONTINUE
NSAM=I(5)
N3=I(N1-2)
NGEN= N3 -100
GO TO (101,102,103,104,105,106,107,108,109,110,111,112),NGEN
112 RETURN
C UNIT GENERATORS
C OUTPUT BOX
101 IF(M1)260,260,261
260 IN1=I(L1)
261 CONTINUE
DO 270J3=1,NSAM
IF(M1)265,265,264
264 J4=L1+J3-1
IN1=I(J4)
265 J5=L2+J3-1
I(J5)=IN1+I(J5)
270 CONTINUE
RETURN
C OSCILLATOR
102 SUM=FLOAT(I(L5))*SFI
IF(M1)280,280,281
280 AMP=FLOAT(I(L1))*SFI
281 IF(M2)282,282,283
282 FREQ=FLOAT(I(L2))*SFI
283 CONTINUE
DO 293J3=1,NSAM
J4=INT(SUM)+L4
F=FLOAT(I(J4))
IF(M2)285,285,286
285 SUM=SUM+FREQ
GO TO 290
286 J4=L2+J3-1
SUM=SUM+FLOAT(I(J4))*SFI
CC 290 IF(SUM-XNFUN)288,287,287
290 IF(SUM.GE.XNFUN)GO TO 287
CC 287 SUM=SUM-XNFUN
IF(SUM.LT.0.0)GO TO 289
288 J5=L3+J3-1
IF(M1)291,291,292
291 I(J5)=IFIX(AMP*F*SFXX)
GO TO 293
C**********
287 SUM=SUM-XNFUN
GO TO 288
289 SUM=SUM+XNFUN
GO TO 288
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
292 J6=L1+J3-1
I(J5)=IFIX(FLOAT(I(J6))*F*SFF)
293 CONTINUE
I(L5)=IFIX(SUM*SFID)
RETURN
C ADD TWO BOX
103 IF(M1)250,250,251
250 IN1=I(L1)
251 IF(M2)252,252,253
252 IN2=I(L2)
253 DO 258J3=1,NSAM
IF(M1)255,255,254
254 J4=L1+J3-1
IN1=I(J4)
255 IF(M2) 257,257,256
256 J5=L2+J3-1
IN2=I(J5)
257 J6=L3+J3-1
I(J6)=IN1+IN2
258 CONTINUE
RETURN
C RANDOM INTERPOLATING GENERATOR
104 SUM=FLOAT(I(L4))*SFI
IF(M1)310,310,311
310 XIN1=FLOAT(I(L1))*SFI
311 IF(M2)312,312,313
312 XIN2=FLOAT(I(L2))*SFI
313 IRN1=I(L5)
IRN3=I(L6)
DO 340J3=1,NSAM
IF(M1)316,316,315
315 J4=L1+J3-1
XIN1=FLOAT(I(J4))*SFI
316 IF(M2)318,318,317
317 J5=L2+J3-1
XIN2=FLOAT(I(J5))*SFI
318 IF(SUM-XNFUN)320,319,319
319 SUM=SUM-XNFUN
I(7)=IABS (I(7)*IMULT)
RN4=(2.*FLOAT(I(7))*SFF-1.)
RN2=RN4-RN3
RN1=RN3
RN3=RN4
GO TO 321
320 RN2=RN3-RN1
321 J7=L3+J3-1
I(J7)=XIN1*(RN1+(RN2*SUM)/XNFUN)*SFID
SUM=SUM+XIN2
340 CONTINUE
I(L4)=IFIX(SUM*SFID)
I(L5)=IRN1
I(L6)=IRN3
RETURN
C ENVELOPE GENERATOR
105 SUM=FLOAT(I(L7))*SFI
IF(M1)380,380,381
380 XIN1=FLOAT(I(L1))*SFI
381 IF(M4)382,382,383
382 XIN4=FLOAT(I(L4))*SFI
383 IF(M5)384,384,385
384 XIN5=FLOAT(I(L5))*SFI
385 IF(M6)386,386,387
386 XIN6=FLOAT(I(L6))*SFI
387 X1=XNFUN/4.
X2=2.*X1
X3=3.*X1
DO 403 J3=1,NSAM
J4=INT(SUM)+L2
F=FLOAT(I(J4))
IF(M1)405,405,404
404 J8=L1+J3-1
XIN1=FLOAT(I(J8))*SFI
405 IF(SUM-XNFUN)389,388,388
388 SUM=SUM-XNFUN
389 IF(SUM-X1)390,390,393
390 IF(M4)392,392,391
391 J4=L4+J3-1
XIN4=FLOAT(I(J4))*SFI
392 SUM=SUM+XIN4
GO TO 402
393 IF(SUM-X2)394,394,397
394 IF(M5)396,396,395
395 J5=L5+J3-1
XIN5=FLOAT(I(J5))*SFI
396 SUM=SUM+XIN5
GO TO 402
397 IF(M6)400,400,399
399 J6=L6+J3-1
XIN6=FLOAT(I(J6))*SFI
400 SUM=SUM+XIN6
402 J7=L3+J3-1
I(J7)=IFIX(XIN1*F*SFXX)
403 CONTINUE
I(L7)=IFIX(SUM*SFID)
RETURN
C STEREO OUTPUT BOX
106 IF(M1)500,500,501
500 IN1=I(L1)
501 IF(M2)502,502,503
502 IN2=I(L2)
503 NSSAM=2*NSAM
C 6/29/70 L.C.SMITH
ICT=0
DO 510J3=1,NSSAM,2
IF(M1)505,505,504
CC*** 504 J4=L1+J3-1
504 J4=L1+ICT
IN1=I(J4)
505 J5=L3+J3-1
I(J5)=IN1+I(J5)
IF(M2)507,507,506
CC*** 506 J4=L2+J3-1
506 J4=L2+ICT
IN2=I(J4)
507 J5=L3+J3
I(J5)=IN2+I(J5)
C*** 6/77 LCS 510 CONTINUE
510 ICT=ICT+1
RETURN
C ADD 3 BOX
107 IF(M1)750,750,751
750 IN1=I(L1)
751 IF(M2)752,752,753
752 IN2=I(L2)
753 IF(M3)754,754,755
754 IN3=I(L3)
755 DO 780J3=1,NSAM
IF(M1)757,757,756
756 J4=L1+J3-1
IN1=I(J4)
757 IF(M2)759,759,758
758 J5=L2+J3-1
IN2=I(J5)
759 IF(M3)761,761,760
760 J6=L3+J3-1
IN3=I(J6)
761 J7=L4+J3-1
I(J7)=IN1+IN2+IN3
780 CONTINUE
RETURN
C ADD 4 BOX
108 IF(M1)850,850,851
850 IN1=I(L1)
851 IF(M2)852,852,853
852 IN2=I(L2)
853 IF(M3)854,854,855
854 IN3=I(L3)
855 IF(M4)856,856,857
856 IN4=I(L4)
857 DO 880J3=1,NSAM
IF(M1)859,859,858
858 J4=L1+J3-1
IN1=I(J4)
859 IF(M2)861,861,860
860 J5=L2+J3-1
IN2=I(J5)
861 IF(M3)863,863,862
862 J6=L3+J3-1
IN3=I(J6)
863 IF(M4)865,865,864
864 J7=L4+J3-1
IN4=I(J7)
865 J8=L5+J3-1
I(J8)=IN1+IN2+IN3+IN4
880 CONTINUE
RETURN
C MULTIPLIER
109 IF(M1)900,900,901
900 XIN1=FLOAT(I(L1))*SFI
901 IF(M2)902,902,903
902 XIN2=FLOAT(I(L2))*SFI
903 DO 908J3=1,NSAM
IF(M1)905,905,904
904 J4=L1+J3-1
XIN1=FLOAT(I(J4))*SFI
905 IF(M2)907,907,906
906 J5=L2+J3-1
XIN2=FLOAT(I(J5))*SFI
907 J6=L3+J3-1
I(J6)=XIN1*XIN2*SFID
908 CONTINUE
RETURN
C SET NEW FUNCTION IN OSC OR ENV
110 ILOC=N1+6
IF(I(N1+1).EQ.105) ILOC=N1+4
IN1=I(3)+I(N1)-1
IIN1=I(IN1)/IP(12)
IF(IIN1)960,960,955
955 I(ILOC)=-IP(2)-(IIN1-1)*IP(6)
960 RETURN
C RANDOM AND HOLD GENERATOR
111 SUM=FLOAT(I(L4))*SFI
IF(M1)910,910,911
910 XIN1=FLOAT(I(L1))*SFI
911 IF(M2)912,912,913
912 XIN2=FLOAT(I(L2))*SFI
913 IRN=I(L5)
DO 940J3=1,NSAM
IF(M1)916,916,915
915 J4=L1+J3-1
XIN1=FLOAT(I(J4))*SFI
916 IF(M2)918,918,917
917 J5=L2+J3-1
XIN2=FLOAT(I(J5))*SFI
918 IF(SUM-XNFUN)920,919,919
919 SUM=SUM-XNFUN
I(7)=IABS (I(7)*IMULT)
RN=(2.*FLOAT(I(7))*SFF-1.)
920 J7=L3+J3-1
I(J7)=XIN1*RN*SFID
SUM=SUM+XIN2
940 CONTINUE
I(L4)=IFIX(SUM*SFID)
I(L5)=IRN
RETURN
END
CGEN1 FUNCTION GENERATOR 1
C *** MUSIC V ***
SUBROUTINEGEN1
DIMENSIONI(15000),P(100),IP(20)
COMMON I,P/PARM/IP
N1=IP(2)+(IFIX(P(4))-1)*IP(6)
M1=7
SCLFT=IP(15)
102 IF(P(M1+1))103,103,100
100 V1=P(M1-2)*SCLFT
V2=(P(M1)-P(M1-2))/(P(M1+1)-P(M1-1))*SCLFT
MA=N1+IFIX(P(M1-1))
MB=N1+IFIX(P(M1+1))-1
DO 101J=MA,MB
XJ=J-MA
101 I(J)=V1+V2*XJ
IF(IFIX(P(M1+1)).EQ.(IP(6)-1))GO TO 103
M1=M1+2
GO TO 102
103 I(MB+1)=P(M1)*SCLFT
RETURN
END
CGEN2 FUNCTION GENERATOR 2
C *** MUSIC V ***
SUBROUTINEGEN2
DIMENSIONI(15000),P(100),IP(20),A(7000)
COMMON I,P/PARM/IP
EQUIVALENCE(I,A)
SCLFT=IP(15)
N1=IP(2)+(IFIX(P(4))-1)*IP(6)
N2=N1+IP(6)-1
DO 101K1=N1,N2
101 A(K1)=0.0
FAC=6.283185/(FLOAT(IP(6))-1.0)
NMAX=I(1)
N3=5+INT(ABS(P(NMAX)))-1
IF(N3-5)104,100,100
100 DO 103J=5,N3
FACK=FAC*FLOAT(J-4)
DO 102K=N1,N2
102 A(K)=A(K)+SIN(FACK*FLOAT(K-N1))*P(J)
103 CONTINUE
104 N4=N3+1
N5=I(1)-1
IF(N5-N4)114,105,105
105 DO 107J1=N4,N5
FACK=FAC*FLOAT(J1-N4)
DO 106K1=N1,N2
106 A(K1)=A(K1)+COS(FACK*FLOAT(K1-N1))*P(J1)
107 CONTINUE
114 CONTINUE
IF(P(NMAX))112,112,108
108 FMAX=0.0
DO 110K2=N1,N2
IF(ABS(A(K2))-FMAX)110,110,109
109 FMAX=ABS(A(K2))
110 CONTINUE
113 DO 111K3=N1,N2
111 I(K3)=(A(K3)*SCLFT*.99999)/FMAX
RETURN
112 FMAX=.99999
GO TO 113
END
CGEN3 FUNCTION GENERATOR 3
C *** MUSIC V ***
C ASSUMPTIONS--P(4) = THE NUMBER OF THE FUNCTION TO BE GENERATED,
C I(1) = WORD COUNT FOR CURRENT DATA RECORD
C P(5) = THE BEGINNING THE THE LIST OF DESCRIPTION NUMBERS
C IP(2) = THE BEGINNING SUBSCRIPT FOR FUNCTIONS IN THE I ARRAY,
C IP(6) = THE LENGTH OF THE FUNCTIONS
C IP(15) = SCALE FACTOR FOR STORED FUNCTIONS
C
SUBROUTINE GEN3
COMMON I(15000),P(100) /PARM/ IP(20)
N=I(1)-5
NL=5
SCLFT=IP(15)
LL=IP(6)
RMIN=0
RMAX=0
NR=NL+N
DO 10 J=NL,NR
IF(P(J).GT.RMAX) RMAX=P(J)
10 IF(P(J).LT.RMIN) RMIN=P(J)
DIV=AMAX1(ABS(RMIN),ABS(RMAX))
N1 = IP(2) + (IFIX(P(4))-1)*IP(6)
I(N1)=(P(NL)/DIV)*SCLFT
LAST = N1
DO 100 J=1,N
LL = LL-LL/(N-J+1)
IX = N1+IP(6)-LL-1
IX2 = NL+J
I(IX)=(P(IX2)/DIV)*SCLFT
DELTA=FLOAT(I(IX))-FLOAT(I(LAST))
NR = IX-LAST-1
SEG = NR+1
HNCR=DELTA/SEG
DO 50 K=1,NR
IX2 = LAST+K
50 I(IX2)=FLOAT(I(IX2-1))+HNCR
100 LAST=IX
RETURN
END
CDATA3 PASS 3 DATA INPUTING ROUTINE
C *** MUSIC V ***
C*******MUS5TR************************************************
SUBROUTINE DATA (IFIRST)
COMMON I(15000),P(100)
CM IF(N)4,4,2
CM2 READ(N,END=1) K,(P(J),J=1,K)
CM GO TO 3
CM1 N=-1
C WILL NOW GO BACK TO TRANSLATOR.
CM K=0
4 CALL MUS5TR(IFIRST,K,P)
C N=0 FOR INST. READIN; -1 FOR TRANSLATOR
C*******MUS5TR************************************************
3 I(1)=K
END
CPARM CONTROL DATA SPECIFICATION FOR PASS 3
C *** MUSIC V ***
C
C IP(1) = NUMBER OF OP CODES
C IP(2) = BEGINNING SUBSCRIPT OF FIRST FUNCTION
C IP(3) = STANDARD SAMPLING RATE
C IP(4) = BEGINNING SUBSCRIPT OF INSTRUMENT DEFINITIONS
C IP(5) = BEGINNING OF LOCATION TABLE FOR INSTRUMENT DEFINITIONS
C IP(6) = LENGTH OF FUNCTIONS
C IP(7) = BEGINNING OF NOTE CARD PARAMETERS
C IP(8) = LENGTH OF NOTE CARD PARAMETER BLOCKS
C IP(9) = NUMBER OF NOTE CARD PARAMETER BLOCKS
C IP(10)= BEGINNING OF OUTPUT DATA BLOCK
C IP(11)= SOUND ZERO (SILENCE VALUE)
C IP(12)= SCALE FACTOR FOR NOTE CARD PARAMETERS
C IP(13)= BEGINNING OF GENERATOR INPUT-OUTPUT BLOCKS
C IP(14)= LENGTH OF GENERATOR INPUT-OUTPUT BLOCKS
C IP(15)= SCALE FACTOR FOR FUNCTIONS
C
BLOCK DATA
COMMON /PARM/IP(20)
DATA IP/12,512,10000,14500,14400,512,13000,35,40,6657,2048,
1 "1000000,6657,512,"377777777777,5*0/
C*****BIG NUMB. IS IBM360'S BIGGEST. 1 65536,6657,512,Z7FFFFFFF/
END
CC****SUBROUTINE DUM
CC****ENTRY SAMGEN
CC****ENTRY GEN4
CC****ENTRY GEN5
CC****END
SUBROUTINE SAMGEN
RETURN
END
SUBROUTINE GEN4
END
SUBROUTINE GEN5
END
C **** DUMMY SUBROUTINES ****
SUBROUTINE FROUT3(IDSK)
C TERMINATE OUTPUT
INTEGER PEAK
COMMON I(15000),P(100)/PARM/IP(20)/FINOUT/PEAK,NRSOR
C****MUS5TR****************************************
DIMENSION IHD(1)
EQUIVALENCE (IHD,P(51))
C ONLY 35 PARAMS ARE SAVED IN MUS5TR
C****MUS5TR****************************************
K=IP(10)
L=IP(10)+IP(14)-1
DO 1 J=K,L
1 I(J)=0
CALL SAMOUT(IDSK,IP(14))
CC REWIND NWRITE
CC WRITE (6,10) PEAK,NRSOR
TYPE 10,PEAK,NRSOR
CC*** CALL EXIT
C****MUS5TR****************************************
IF(IDSK.LT.0)CALL EXIT
J=IP(10)
L=J+1024
DO 2 K=J,L
2 I(K)=0
C WILL WRITE 1024 0'S ON DSK.
CIRC???? CALL FASTOU(I(J),1024)
CALL WRTHD
C DOES A USETO
IHD(1)="525252525252
IHD(2)=I(4)
C I(4)=SRATE
IHD(3)=0
C 0=12-BIT
C (4)NCHNS←1 OR 2
IHD(4)=I(8)+1
IF(IHD(4).EQ.0)IHD(4)=1
C (5)MAXAMP (FLTING PT.) (6)=NUM. OF SAMPLES
P(55)=PEAK
IHD(6)=0
CALL FASTOU(IHD,128)
C THE HEADER (SUCH AS IT IS)
CALL FINFIL
CALL PLAY
C****MUS5TR****************************************
CCC CALL EXIT
10 FORMAT ('0PEAK AMPLITUDE WAS',I8/'0NUMBER OF SAMPLES OUT OF RANGE
1WAS',I8)
END
CDSMOUT DEBUG SAMOUT
C *** MUSIC V ***
C DEBUG SAMOUT
SUBROUTINE SAMOUT(IDSK,N)
DIMENSION IDBUF(3071)
CZ DIMENSION IDBUF(2000),MS(3)
C*** IDSK IS FLAG TO WRITE SAMPLES ON DSK -- PDP *****
C*** IDBUF WILL STORE PACKED SAMPLES. ****
DIMENSIONI(15000),T(10),P(100),IP(20)
COMMON I,P/PARM/IP/FINOUT/PEAK,NRSOR
INTEGER PEAK
MNST=768
IF(I(8).NE.0)MNST=1536
CX IF(IDSK.GE.0)GO TO 99
CX N1=N
CX PRINT100,N1
CX 100 FORMAT(7H OUTPUTI6,8H SAMPLES)
CX N2=IP(10)-1
CX N3=10
CX GO TO 104
CX106 DO 101L=1,10
CX J=N2+L
CX101 T(L)=FLOAT(I(J))/FLOAT(IP(12))
CX PRINT102,(T(K),K=1,N3)
CX102 FORMAT(1H 10F11.4)
CX N2=N2+10
CX N1=N1-10
CX IF(N1)103,103,104
CX103 RETURN
CX104 IF(N1-10)105,106,106
CX105 N3=N1
CX GO TO 106
99 J=IDSK+1
KOUT=MNST/3
M1=IP(10)
ISC=IP(12)
IDSK=IDSK+N
M2=0
C COUNTS SAMPLES TO DATE
DO 1 K=J,IDSK
N1=I(M1+M2)/ISC
IF(N1.GT.PEAK)PEAK=N1
IDBUF(K)=N1
1 M2=M2+1
IF(IDSK.LT.MNST)RETURN
C****MUS5TR****************************************
KL=0
C************ BELOW IS FAIL ROUTINE TO PACK 3 SMPLS INTO 2 WD.
DO 2 K=1,MNST,3
KL=KL+1
2 CALL PACK(IDBUF(KL),IDBUF(K))
C************ ABOVE IS FAIL ROUTINE TO PACK 3 SMPLS INTO 2 WD.
C************ BELOW IS FORTRAN ROUTINE TO PACK 3 SMPLS INTO 2 WD.
CZ DO 2 K=1,768,3
CZ KL=KL+1
CZ KJ=K-1
CZ MS(1)=IDBUF(K)
CZ IF(MS(1).EQ.2048)MS(1)=2047
C A 2048 IN THE 12 LEFT HAND BITS CREATES PROBLEMS
CZ DO 3 L=2,3
CZ MS(L)=IDBUF(KJ+L)
CZ3 IF(MS(L).LT.0)MS(L)=4096+MS(L)
CZ2 IDBUF(KL)=MS(3)+MS(2)*4096+MS(1)*16777216
C PACKS 3 SMPLS TO A 36-BIT WORD. 4096=2**12, 16---=2**24.
C MS(1) HAS LEFT HAND 12 BITS; MS(2), MIDDLE 12 BITS; MS(3), RIGHT 12.
C NEGATIVE NUMBERS RUN FROM 4095(I.E. -1) TO 2049(I.E. -2048).
C************ ABOVE IS FORTRAN ROUTINE TO PACK 3 SMPLS INTO 2 WD.
CALL FASTOU(IDBUF(1),KOUT)
J=IDSK-MNST
IF(J.LT.1)GO TO 4
DO 5 K=1,J
5 IDBUF(K)=IDBUF(MNST+K)
4 IDSK=J
C****MUS5TR****************************************
RETURN
END
CERRO1 GENERAL ERROR ROUTINE
C *** MUSIC V ***
SUBROUTINEERROR(I)
PRINT100,I
100 FORMAT (' ERROR OF TYPE',I5)
RETURN
END